home *** CD-ROM | disk | FTP | other *** search
/ CD Exchange / CD Exchange - Volume 1.iso / d.t.p / utils / propage / donsgenies / donsgenies.lha / Don'sGenies / FitBitmapsToBoxes.pprx < prev    next >
Text File  |  1993-05-25  |  1KB  |  52 lines
  1. /* Fit image exactly into box, distorting as needed, assuming a screen resolution of 75 dpi in hi-res.
  2. Written by Don Cox  July '92 Not Public Domain. All rights reserved. */
  3.  
  4.  
  5. signal on error
  6. signal on syntax
  7.  
  8. address command
  9. call ppm_AutoUpdate(0)
  10. call SafeEndEdit.rexx()
  11. oldunits = ppm_GetUnits()
  12. call ppm_SetUnits(1)
  13.  
  14. do forever
  15.     box = ppm_ClickOnBox("Click on box...")
  16.  
  17.     if box=0 then break
  18.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  19.     if boxtype~="BITMAP" then do
  20.         call ppm_Inform(1,"Not a bitmap box",)
  21.         call ppm_ClearStatus()
  22.         exit
  23.         end
  24.  
  25.     size = ppm_GetBoxSize(box)
  26.     boxwidth = word(size,1)
  27.     boxheight = word(size,2)
  28.     margins = ppm_GetBoxMargins(box)
  29.     parse var margins mleft mtop mright mbottom
  30.     boxwidth = boxwidth-mleft-mright
  31.     boxheight = boxheight-mtop-mbottom
  32.  
  33.  
  34.     info = ppm_GetBoxInfo(box)
  35.     width = word(info,2)
  36.     height = word(info,3)
  37.  
  38.     width = width/75  /* screen images at 75dpi for high res */
  39.     xscale = boxwidth/width
  40.     height = height/75
  41.     yscale = boxheight/height
  42.  
  43.  
  44.     call ppm_SetBoxScale(box,xscale,yscale)
  45.     call ppm_SetBoxOffset(box,0,0)
  46.     end
  47.  
  48. call ppm_SetUnits(oldunits)
  49. call ppm_ClearStatus()
  50. call ppm_AutoUpdate(1)
  51.  
  52. exit